home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / comm / oh10a7.zip / CGI-BIN / CGI-LIB.PL next >
Text File  |  1996-05-17  |  15KB  |  450 lines
  1.  
  2.  
  3. # Perl Routines to Manipulate CGI input
  4. # S.E.Brenner@bioc.cam.ac.uk
  5. # $Id: cgi-lib.pl,v 2.10 1996/05/16 18:27:04 brenner Exp $
  6. #
  7. # Copyright (c) 1996 Steven E. Brenner  
  8. # Unpublished work.
  9. # Permission granted to use and modify this library so long as the
  10. # copyright above is maintained, modifications are documented, and
  11. # credit is given for any use of the library.
  12. #
  13. # Thanks are due to many people for reporting bugs and suggestions
  14. # especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
  15. # Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
  16.  
  17. # For more information, see:
  18. #     http://www.bio.cam.ac.uk/cgi-lib/
  19.  
  20. ($cgi_lib'version = '$Revision: 2.10 $') =~ s/[^.\d]//g;
  21.  
  22.  
  23. # Parameters affecting cgi-lib behavior
  24. # User-configurable parameters affecting file upload.
  25. $cgi_lib'maxdata    = 131072;    # maximum bytes to accept via POST - 2^17
  26. $cgi_lib'writefiles =      0;    # directory to which to write files, or
  27.                                  # 0 if files should not be written
  28. $cgi_lib'filepre    = "cgi-lib"; # Prefix of file names, in directory above
  29.  
  30. # Do not change the following parameters unless you have special reasons
  31. $cgi_lib'bufsize  =  8192;    # default buffer size when reading multipart
  32. $cgi_lib'maxbound =   100;    # maximum boundary length to be encounterd
  33. $cgi_lib'headerout =    0;    # indicates whether the header has been printed
  34.  
  35.  
  36. # ReadParse
  37. # Reads in GET or POST data, converts it to unescaped text, and puts
  38. # key/value pairs in %in, using "\0" to separate multiple selections
  39.  
  40. # Returns >0 if there was input, 0 if there was no input 
  41. # undef indicates some failure.
  42.  
  43. # Now that cgi scripts can be put in the normal file space, it is useful
  44. # to combine both the form and the script in one place.  If no parameters
  45. # are given (i.e., ReadParse returns FALSE), then a form could be output.
  46.  
  47. # If a reference to a hash is given, then the data will be stored in that
  48. # hash, but the data from $in and @in will become inaccessable.
  49. # If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,
  50. # information is stored there, rather than in $in, @in, and %in.
  51. # Second, third, and fourth parameters fill associative arrays analagous to
  52. # %in with data relevant to file uploads. 
  53.  
  54. # If no method is given, the script will process both command-line arguments
  55. # of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
  56. # This is intended to aid debugging and may be changed in future releases
  57.  
  58. sub ReadParse {
  59.   local (*in) = shift if @_;    # CGI input
  60.   local (*incfn,                # Client's filename (may not be provided)
  61.      *inct,                 # Client's content-type (may not be provided)
  62.      *insfn) = @_;          # Server's filename (for spooled files)
  63.   local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn);
  64.     
  65.   # Disable warnings as this code deliberately uses local and environment
  66.   # variables which are preset to undef (i.e., not explicitly initialized)
  67.   $perlwarn = $^W;
  68.   $^W = 0;
  69.     
  70.   # Get several useful env variables
  71.   $type = $ENV{'CONTENT_TYPE'};
  72.   $len  = $ENV{'CONTENT_LENGTH'};
  73.   $meth = $ENV{'REQUEST_METHOD'};
  74.   
  75.   if ($len > $cgi_lib'maxdata) { #'
  76.       &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");
  77.   }
  78.   
  79.   if (!defined $meth || $meth eq '' || $meth eq 'GET' || 
  80.       $type eq 'application/x-www-form-urlencoded') {
  81.     local ($key, $val, $i);
  82.     
  83.     # Read in text
  84.     if (!defined $meth || $meth eq '') {
  85.       $in = $ENV{'QUERY_STRING'};
  86.       $cmdflag = 1;  # also use command-line options
  87.     } elsif($meth eq 'GET' || $meth eq 'HEAD') {
  88.       $in = $ENV{'QUERY_STRING'};
  89.     } elsif ($meth eq 'POST') {
  90.         if (read(STDIN, $in, $len) != $len) {$errflag="Short Read\n";};
  91.     } else {
  92.       &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
  93.     }
  94.  
  95.     @in = split(/[&;]/,$in); 
  96.     push(@in, @ARGV) if $cmdflag; # add command-line parameters
  97.  
  98.     foreach $i (0 .. $#in) {
  99.       # Convert plus to space
  100.       $in[$i] =~ s/\+/ /g;
  101.  
  102.       # Split into key and value.  
  103.       ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  104.  
  105.       # Convert %XX from hex numbers to alphanumeric
  106.       $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  107.       $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
  108.  
  109.       # Associate key and value
  110.       $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  111.       $in{$key} .= $val;
  112.     }
  113.  
  114.   } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
  115.     # for efficiency, compile multipart code only if needed
  116. $errflag = !(eval <<'END_MULTIPART');
  117.  
  118.     local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
  119.     local ($bpos, $lpos, $left, $amt, $fn, $ser);
  120.     local ($bufsize, $maxbound, $writefiles) = 
  121.       ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
  122.  
  123.  
  124.     # The following lines exist solely to eliminate spurious warning messages
  125.     $buf = ''; 
  126.  
  127.     ($boundary) = $type =~ /boundary="([^"]+)"/; #";   # find boundary
  128.     ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
  129.     &CgiDie ("Boundary not provided: probably a bug in your server") 
  130.       unless $boundary;
  131.     $boundary =  "--" . $boundary;
  132.     $blen = length ($boundary);
  133.  
  134.     if ($ENV{'REQUEST_METHOD'} ne 'POST') {
  135.       &CgiDie("Invalid request method for  multipart/form-data: $meth\n");
  136.     }
  137.  
  138.     if ($writefiles) {
  139.       local($me);
  140.       stat ($writefiles);
  141.       $writefiles = "/tmp" unless  -d _ && -r _ && -w _;
  142.       # ($me) = $0 =~ m#([^/]*)$#;
  143.       $writefiles .= "/$cgi_lib'filepre"; 
  144.     }
  145.  
  146.     # read in the data and split into parts:
  147.     # put headers in @in and data in %in
  148.     # General algorithm:
  149.     #   There are two dividers: the border and the '\r\n\r\n' between
  150.     # header and body.  Iterate between searching for these
  151.     #   Retain a buffer of size(bufsize+maxbound); the latter part is
  152.     # to ensure that dividers don't get lost by wrapping between two bufs
  153.     #   Look for a divider in the current batch.  If not found, then
  154.     # save all of bufsize, move the maxbound extra buffer to the front of
  155.     # the buffer, and read in a new bufsize bytes.  If a divider is found,
  156.     # save everything up to the divider.  Then empty the buffer of everything
  157.     # up to the end of the divider.  Refill buffer to bufsize+maxbound
  158.     #   Note slightly odd organization.  Code before BODY: really goes with
  159.     # code following HEAD:, but is put first to 'pre-fill' buffers.  BODY:
  160.     # is placed before HEAD: because we first need to discard any 'preface,'
  161.     # which would be analagous to a body without a preceeding head.
  162.  
  163.     $left = $len;
  164.    PART: # find each part of the multi-part while reading data
  165.     while (1) {
  166.       die $@ if $errflag;
  167.  
  168.       $amt = ($left > $bufsize+$maxbound-length($buf) 
  169.           ?  $bufsize+$maxbound-length($buf): $left);
  170.       $errflag = (read(STDIN, $buf, $amt, length($buf)) != $amt);
  171.       die "Short Read\n" if $errflag;
  172.       $left -= $amt;
  173.  
  174.       $in{$name} .= "\0" if defined $in{$name}; 
  175.       $in{$name} .= $fn if $fn;
  176.  
  177.       $name=~/([-\w]+)/;  # This allows $insfn{$name} to be untainted
  178.       if (defined $1) {
  179.         $insfn{$1} .= "\0" if defined $insfn{$1}; 
  180.         $insfn{$1} .= $fn if $fn;
  181.       }
  182.  
  183.      BODY: 
  184.       while (($bpos = index($buf, $boundary)) == -1) {
  185.         die $@ if $errflag;
  186.         if ($name) {  # if no $name, then it's the prologue -- discard
  187.           if ($fn) { print FILE substr($buf, 0, $bufsize); }
  188.           else     { $in{$name} .= substr($buf, 0, $bufsize); }
  189.         }
  190.         $buf = substr($buf, $bufsize);
  191.         $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
  192.         $errflag = (read(STDIN, $buf, $amt, $maxbound) != $amt);  
  193.     die "Short Read\n" if $errflag;
  194.         $left -= $amt;
  195.       }
  196.       if (defined $name) {  # if no $name, then it's the prologue -- discard
  197.         if ($fn) { print FILE substr($buf, 0, $bpos-2); }
  198.         else     { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
  199.       }
  200.       clos